# TODO: 
#     -[] clean code
#     -[] predicted value plots for E and F

library(tidyverse)
## ── Attaching packages ────────────────────────────────────────────────────────────── tidyverse 1.3.1 ──
## ✓ ggplot2 3.3.5     ✓ purrr   0.3.4
## ✓ tibble  3.1.6     ✓ dplyr   1.0.8
## ✓ tidyr   1.2.0     ✓ stringr 1.4.0
## ✓ readr   2.1.2     ✓ forcats 0.5.1
## ── Conflicts ───────────────────────────────────────────────────────────────── tidyverse_conflicts() ──
## x dplyr::filter() masks stats::filter()
## x dplyr::lag()    masks stats::lag()
theme_set(theme_minimal())
library(broom)
library(patchwork)
library(ggbeeswarm)
library(dagitty)
library(ggdag)
## 
## Attaching package: 'ggdag'
## The following object is masked from 'package:stats':
## 
##     filter
## <https://cran.r-project.org/web/packages/ggdag/vignettes/intro-to-ggdag.html>
library(gt)
library(gtsummary)
## #BlackLivesMatter
## Need Hmisc for bootstrap CIs in some plots, but don't want to load it
find.package('Hmisc')
## [1] "/Users/danhicks/Library/Caches/org.R-project.R/R/renv/library/transparency-b4b6f02c/R-4.1/x86_64-apple-darwin17.0/Hmisc"
library(here)
## here() starts at /Users/danhicks/Google Drive/Writing/transparency
source(here('R', 'reg_tbl.R'))
source(here('R', 'plot_adjustments.R'))
source(here('R', 'reg_plots.R'))

library(car)
## Loading required package: carData
## 
## Attaching package: 'car'
## The following object is masked from 'package:dplyr':
## 
##     recode
## The following object is masked from 'package:purrr':
## 
##     some
options(contrasts = c('contr.Treatment', 'contr.poly'))
options(decorate.contr.Treatment = '')

out_dir = here('out')
if (!dir.exists(out_dir)) {
    dir.create(out_dir)
}
data_dir = here('data')

## Load data ----
## Elliott et al. data
emad_df = read_rds(here(data_dir, 'emad.Rds'))

## Our data
dataf = read_rds(here(data_dir, 'data.Rds'))

## Descriptive summary of our data ----
## - age
## - gender
## - race/ethnicity
##    - <https://www.census.gov/library/visualizations/interactive/race-and-ethnicity-in-the-united-state-2010-and-2020-census.html>
##    - overrep White (72% vs. 62%)
##    - underrep Hispanic (3% vs. 19%)
##    - Black and A/PI represented accurately at 13% and 6%
## - religious affiliation
## - religious services
## - political ideology
## - political affiliation
## - education
##    - <https://www.statista.com/statistics/184260/educational-attainment-in-the-us/>
##    - underrep non-HS grads (1% vs. 9%)
##    - overrep college grads (57% vs. 38%)
## - participant values

re_labels = c('American Indian or Alaskan Native', 
              'Asian or Pacific Islander', 
              'Black', 
              'Hispanic', 
              'White', 
              'Other', 
              'Prefer not to answer')
relig_labels = c('Buddhist', 
                 'Catholic', 
                 'Hindu', 
                 'Jewish', 
                 'Muslim', 
                 'Protestant', 
                 'No religion', 
                 'Other', 'Prefer not to answer')
relig_serv_labels = c('Never', 
                      'A few times per year', 
                      'Once every month or two', 
                      '2-3 times per month', 
                      'Once per week', 
                      'More than once per week', 
                      'Daily')
poli_id_labels = c('Strongly liberal', 
                   'Moderately liberal', 
                   'Mildly liberal', 
                   'Centrist', 
                   'Mildly conservative', 
                   'Moderately conservative', 
                   'Strongly conservative', 
                   'Other', 
                   'Prefer not to answer')
poli_aff_labels = c('Democratic party', 
                    'Republican party', 
                    'Independent/no party', 
                    'Other', 
                    'Prefer not to answer')
edu_labels = c('Less than high school', 
               'High school, or some college', 
               'Bachelor’s degree or higher')
fix_multifac = function(vec, labs, ordered = FALSE) {
    chr = vec |> 
        as.character() |> 
        str_split(',') |> 
        map(~ labs[as.integer(.x)]) |> 
        map_chr(str_c, collapse = '/')
    if (!ordered) {
        return(chr)
    } else {
        fct_relevel(chr, labs)
    }
}


demo_gt = dataf |> 
    select(pid, age, gender, race_ethnicity, 
           religious_affil, religious_serv,
           political_ideology, political_affiliation, 
           education, part_values, disclosure) |> 
    mutate(gender = fct_drop(gender),
           race_ethnicity = fix_multifac(race_ethnicity, re_labels), 
           religious_affil = fix_multifac(religious_affil, relig_labels), 
           religious_serv = fix_multifac(religious_serv, relig_serv_labels, 
                                         ordered = TRUE), 
           political_ideology = fix_multifac(political_ideology, poli_id_labels, 
                                             ordered = TRUE),
           political_affiliation = fix_multifac(political_affiliation, 
                                                poli_aff_labels), 
           education = fix_multifac(education, edu_labels, ordered = TRUE)) |>
    select(-pid) |> 
    tbl_summary(label = list(race_ethnicity ~ 'race/ethnicity', 
                             religious_affil ~ 'religious affiliation', 
                             religious_serv ~ 'religious service attendance', 
                             political_ideology ~ 'political ideology', 
                             political_affiliation ~ 'political affiliation', 
                             part_values ~ 'participant values'), 
                sort = list(race_ethnicity ~ 'frequency', 
                            religious_affil ~ 'frequency')) |> 
    bold_labels()
## Warning: Unknown levels in `f`: Other, Prefer not to answer
demo_gt |> 
    as_flex_table() |> 
    flextable::save_as_docx(path = here(out_dir, '03_demo_table.docx'), 
                            pr_section = officer::prop_section(page_size = officer::page_size(orient = "landscape")))


## Trust, overall ----
ggplot() +
    geom_violin(aes(x = 'EMAD', pa_mean), 
                draw_quantiles = .5,
                data = emad_df) +
    geom_beeswarm(aes(x = 'EMAD', pa_mean), 
                  data = emad_df) +
    geom_violin(aes(x = 'HL', meti_mean), 
                draw_quantiles = .5, 
                data = dataf) +
    geom_beeswarm(aes(x = 'HL', meti_mean), 
                  data = dataf) +
    ylab('mean trust')

Across our dataset, standard deviation of mean trust. Use one-third of this as meaningful.

sd(dataf$meti_mean)
## [1] 1.288985
meaningful = sd(dataf$meti_mean)/3
meaningful
## [1] 0.4296617
## A. Modest correlation between values and ideology ----

A. Modest correlation between values and ideology

(i) Political liberals are more likely to prioritize public health over economic growth, compared to political conservatives; but (ii) a majority of political conservatives prioritize public health.

NB 1. No DAG here because this isn’t a causal claim. 2. Direction of ideology coding is reversed between the two studies.

Compared to Elliott et al., our strong conservatives placed lower value on public health, and overall conservatives are about 50-50.

emad_df |>
    count(ideology, tradeoff) |>
    group_by(ideology) |>
    mutate(share = n / sum(n)) |>
    ungroup() |>
    ggplot(aes(ideology, n, fill = as.factor(tradeoff))) +
    geom_col() +
    scale_fill_viridis_d()

last_plot() + aes(y = share)

part_values_plot = dataf |> 
    filter(!is.na(pref)) |> 
    count(political_ideology, part_values) |> 
    group_by(political_ideology) |> 
    mutate(share = n / sum(n)) |> 
    ungroup() |> 
    ggplot(aes(political_ideology, n, fill = part_values)) +
    geom_col(color = 'black') +
    scale_x_continuous(labels = NULL, 
                       name = '← liberal                   conservative →\npolitical ideology') +
    scale_fill_viridis_d(option = 'E', name = 'participant\nvalues')
part_values_plot
## Warning: Removed 2 rows containing missing values (position_stack).

part_values_share = part_values_plot + aes(y = share) +
    scale_y_continuous(labels = scales::percent_format())
part_values_share
## Warning: Removed 2 rows containing missing values (position_stack).

part_values_plot + part_values_share +
    plot_layout(guides = 'collect') +
    plot_annotation(tag_levels = 'A')
## Warning: Removed 2 rows containing missing values (position_stack).
## Removed 2 rows containing missing values (position_stack).

ggsave(here(out_dir, '03_part_values.png'), 
       height = 4, width = 8, dpi = 200, scale = 1.5)
## Warning: Removed 2 rows containing missing values (position_stack).
## Removed 2 rows containing missing values (position_stack).
table(dataf$political_ideology, dataf$pref)
##    
##       1   2   3   4
##   1   5   1  18 133
##   2   9  13  47 135
##   3   5  14  44  66
##   4  16  19  31  39
##   5  13  18  22  27
##   6  22  27  18  25
##   7  19   9   3   6
dataf |> 
    mutate(political_ideology = case_when(
        political_ideology < 4 ~ 'liberal', 
        political_ideology == 4 ~ 'moderate', 
        political_ideology > 4 ~ 'conservative'
    )) |> 
    count(political_ideology)
## # A tibble: 4 × 2
##   political_ideology     n
##   <chr>              <int>
## 1 conservative         248
## 2 liberal              574
## 3 moderate             118
## 4 <NA>                  48
cor(emad_df$ideology, emad_df$tradeoff, 
    use = 'complete.obs',
    method = 'spearman')
## [1] 0.2717778
cor(as.integer(dataf$political_ideology), as.integer(dataf$pref), 
    use = 'complete.obs', 
    method = 'spearman')
## [1] -0.4712353
glm(I(part_values == 'economic growth') ~ political_ideology, 
    family = 'binomial', 
    data = dataf) |> 
    summary()
## 
## Call:
## glm(formula = I(part_values == "economic growth") ~ political_ideology, 
##     family = "binomial", data = dataf)
## 
## Deviance Residuals: 
##     Min       1Q   Median       3Q      Max  
## -1.5838  -0.6027  -0.4484  -0.3306   2.4225  
## 
## Coefficients:
##                    Estimate Std. Error z value Pr(>|z|)    
## (Intercept)        -3.51269    0.24200  -14.52   <2e-16 ***
## political_ideology  0.63300    0.05455   11.61   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## (Dispersion parameter for binomial family taken to be 1)
## 
##     Null deviance: 879.25  on 803  degrees of freedom
## Residual deviance: 711.42  on 802  degrees of freedom
##   (184 observations deleted due to missingness)
## AIC: 715.42
## 
## Number of Fisher Scoring iterations: 5
## DAG ----

DAG

We use the following DAG throughout the rest of this analysis

dag = dagify(METI ~ shared_values + sci_values +
                 part_values + demographics,
             shared_values ~ part_values + sci_values, 
             part_values ~ demographics,
             outcome = 'METI') |> 
    tidy_dagitty(layout = 'kk')

ggplot(dag, aes(x = x, y = y, 
                xend = xend, yend = yend)) +
    geom_label(aes(label = name)) +
    geom_dag_edges() +
    coord_cartesian(clip = 'off') +
    theme_dag()

## B. Consumer risk sensitivity ----

B. Consumer risk sensitivity

Scientists who find that a chemical harms human health are perceived as more trustworthy than scientists who find that a chemical does not cause harm.

ggplot(emad_df, aes(conclusion, pa_mean)) +
    geom_violin(draw_quantiles = .5) +
    geom_beeswarm()

ggplot(dataf, aes(conclusion, meti_mean)) +
    geom_violin(draw_quantiles = .5) +
    geom_beeswarm()

Because the conclusion is experimentally manipulated, we don’t need any adjustments.

dag |> 
    add_arrows('conclusion -> METI') |> 
    plot_adjustments(exposure = 'conclusion') +
    scale_color_manual(values = 'black')

model_b_emad = lm(pa_mean ~ conclusion, data = emad_df)
summary(model_b_emad)
## 
## Call:
## lm(formula = pa_mean ~ conclusion, data = emad_df)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -4.6131 -0.8536  0.1012  1.1464  2.4321 
## 
## Coefficients:
##                                 Estimate Std. Error t value Pr(>|t|)    
## (Intercept)                      5.61306    0.08953  62.693  < 2e-16 ***
## conclusion[does not cause harm] -1.04516    0.12415  -8.418 4.12e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.384 on 496 degrees of freedom
## Multiple R-squared:  0.125,  Adjusted R-squared:  0.1233 
## F-statistic: 70.87 on 1 and 496 DF,  p-value: 4.121e-16
model_b = lm(meti_mean ~ conclusion, data = dataf)
summary(model_b)
## 
## Call:
## lm(formula = meti_mean ~ conclusion, data = dataf)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -3.8315 -0.7601  0.0256  0.8730  2.5158 
## 
## Coefficients:
##                                 Estimate Std. Error t value Pr(>|t|)    
## (Intercept)                      5.47437    0.05346  102.40   <2e-16 ***
## conclusion[does not cause harm] -0.99019    0.07576  -13.07   <2e-16 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.191 on 986 degrees of freedom
## Multiple R-squared:  0.1477, Adjusted R-squared:  0.1468 
## F-statistic: 170.8 on 1 and 986 DF,  p-value: < 2.2e-16
plot_residuals(model_b)
## `geom_smooth()` using formula 'y ~ x'

plot_estimate(list(emad = model_b_emad, 
                   hl = model_b),
              str_detect(term, 'conclusion'))

tbl_regression(model_b, intercept = TRUE) |> 
    add_glance_table(include = c(r.squared, nobs, statistic, p.value))
Characteristic Beta 95% CI1 p-value
(Intercept) 5.5 5.4, 5.6 <0.001
conclusion
conclusion[does not cause harm] -1.0 -1.1, -0.84 <0.001
0.148
No. Obs. 988
Statistic 171
p-value <0.001
1 CI = Confidence Interval
list(emad = model_b_emad, 
     hl = model_b) |> 
    reg_tbl()
Characteristic EMAD HL replication
Beta 95% CI1 p-value Beta 95% CI1 p-value
(Intercept) 5.6 5.4, 5.8 <0.001 5.5 5.4, 5.6 <0.001
conclusion
conclusion[does not cause harm] -1.0 -1.3, -0.80 <0.001 -1.0 -1.1, -0.84 <0.001
0.125 0.148
No. Obs. 498 988
Adjusted R² 0.123 0.147
Statistic 70.9 171
p-value <0.001 <0.001
1 CI = Confidence Interval
## C. Transparency penalty ----

C. Transparency penalty

Scientists who disclose values are perceived as less trustworthy than scientists who do not.

{
    trans_plot_emad = ggplot(emad_df, aes(disclosure, pa_mean)) +
        # geom_violin(draw_quantiles = .5) +
        geom_beeswarm(alpha = .25, size = .3) +
        stat_summary(fun.data = mean_cl_boot, color = 'red', 
                     size = 1, fatten = 0) +
        stat_summary(geom = 'line', group = 1L, color = 'red') +
        labs(y = 'trust')
    trans_plot_emad
    
    
    trans_plot_us = ggplot(dataf, aes(disclosure, meti_mean)) +
        geom_beeswarm(alpha = .25, size = .3) +
        stat_summary(fun.data = mean_cl_boot, color = 'red', 
                     size = 1, fatten = 0) +
        stat_summary(geom = 'line', group = 1L, color = 'red') +
        labs(y = 'trust')
    trans_plot_us
    
    trans_plot_emad + 
        ggtitle('EMAD') +
        trans_plot_us +
        ggtitle('HL replication')
    
    ggsave(here(out_dir, '03_transparency.png'), 
           height = 3, width = 6, scale = 1, 
           bg = 'white')
}
## No summary function supplied, defaulting to `mean_se()`
## No summary function supplied, defaulting to `mean_se()`

Again, disclosure/transparency is experimentally controlled, so no adjustment is required.

dag |> 
    add_arrows('disclose -> METI') |> 
    plot_adjustments('disclose') + 
    scale_color_manual(values = 'black')

model_c_emad = lm(pa_mean ~ disclosure, data = emad_df)
summary(model_c_emad)
## 
## Call:
## lm(formula = pa_mean ~ disclosure, data = emad_df)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -4.3917 -0.9519  0.1798  1.2231  2.0802 
## 
## Coefficients:
##                  Estimate Std. Error t value Pr(>|t|)    
## (Intercept)        5.3917     0.1164  46.316  < 2e-16 ***
## disclosure[TRUE]  -0.4719     0.1409  -3.349 0.000871 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.463 on 496 degrees of freedom
## Multiple R-squared:  0.02212,    Adjusted R-squared:  0.02015 
## F-statistic: 11.22 on 1 and 496 DF,  p-value: 0.0008714
model_c = lm(meti_mean ~ disclosure, data = dataf)
summary(model_c)
## 
## Call:
## lm(formula = meti_mean ~ disclosure, data = dataf)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -3.9447 -0.9120  0.0880  0.9839  2.0553 
## 
## Coefficients:
##                  Estimate Std. Error t value Pr(>|t|)    
## (Intercept)       5.05488    0.07115  71.045   <2e-16 ***
## disclosure[TRUE] -0.11018    0.08705  -1.266    0.206    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.289 on 986 degrees of freedom
## Multiple R-squared:  0.001622,   Adjusted R-squared:  0.0006095 
## F-statistic: 1.602 on 1 and 986 DF,  p-value: 0.2059
plot_residuals(model_c)
## `geom_smooth()` using formula 'y ~ x'

# plot_estimate(model_c, 'disclosure')
plot_estimate(list(emad = model_c_emad, 
                   hl = model_c), 
              str_detect(term, 'disclosure'))

list(emad = model_c_emad, 
     hl = model_c) |> 
    reg_tbl()
Characteristic EMAD HL replication
Beta 95% CI1 p-value Beta 95% CI1 p-value
(Intercept) 5.4 5.2, 5.6 <0.001 5.1 4.9, 5.2 <0.001
disclosure
disclosure[TRUE] -0.47 -0.75, -0.20 <0.001 -0.11 -0.28, 0.06 0.2
0.022 0.002
No. Obs. 498 988
Adjusted R² 0.020 0.001
Statistic 11.2 1.60
p-value <0.001 0.2
1 CI = Confidence Interval
## B + C combined table ----
model_bc_emad = lm(pa_mean ~ conclusion + disclosure, data = emad_df)
model_bc = lm(meti_mean ~ conclusion + disclosure, data = dataf)

bc_tbl = list(emad = model_bc_emad, 
              hl = model_bc) |> 
    reg_tbl()
bc_tbl
Characteristic EMAD HL replication
Beta 95% CI1 p-value Beta 95% CI1 p-value
(Intercept) 6.0 5.7, 6.2 <0.001 5.6 5.4, 5.7 <0.001
conclusion
conclusion[does not cause harm] -1.1 -1.3, -0.82 <0.001 -1.0 -1.1, -0.84 <0.001
disclosure
disclosure[TRUE] -0.52 -0.78, -0.26 <0.001 -0.12 -0.28, 0.04 0.14
0.152 0.150
No. Obs. 498 988
Adjusted R² 0.148 0.148
Statistic 44.3 86.6
p-value <0.001 <0.001
1 CI = Confidence Interval
write_reg_tbl(bc_tbl, here(out_dir, '03_bc_tbl'))

## D. Shared values ----

D. Shared values

Given that the scientist discloses values, if the participant and the scientist share the same values, the scientist is perceived as more trustworthy than if the participant and scientist have discordant values.

emad_df |> 
    filter(disclosure, !is.na(part_values)) |> 
    ggplot(aes(shared_values, pa_mean)) +
    geom_violin(draw_quantiles = .5) +
    geom_beeswarm()

dataf |> 
    filter(disclosure, !is.na(part_values)) |> 
    ggplot(aes(shared_values, meti_mean)) +
    geom_violin(draw_quantiles = .5) +
    geom_beeswarm()

In our actual situation, we only need to adjust for participant values and scientist values; participant values is on every back-door path running through demographics or VISS variables.

plot_adjustments(dag, 'shared_values') +
    coord_cartesian(clip = 'off')

ggsave(here(out_dir, '03_shared_values_dag.png'), 
       height = 3, width = 6, dpi = 200, scale = 1.5)

However, if participant values and shared values had some common cause problem_var, then participant values is a collider between problem_var and demographics; either we control for problem_var or we control all the demographics (and possibly worry about the exact structure of the demographics subgraph). Big problem if we didn’t observe problem_var! Fortunately we know by construction of shared values that there is no such common cause.

dag |> 
    add_arrows(c('problem_var -> shared_values', 
                 'problem_var -> part_values')) |> 
    plot_adjustments('shared_values')

This doesn’t happen if we have a problem variable elsewhere, because participant values is not a collider on any path that might result.

dag |> 
    add_arrows(c('part_values <- problem_var -> demographics')) |> 
    plot_adjustments('shared_values')

So, all together, we just need to adjust for participant values and scientist values.

model_d_emad = emad_df |> 
    filter(disclosure) %>%
    lm(pa_mean ~ shared_values + part_values + sci_values, data = .)
summary(model_d_emad)
## 
## Call:
## lm(formula = pa_mean ~ shared_values + part_values + sci_values, 
##     data = .)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -4.0914 -0.9710  0.0515  1.0508  2.4678 
## 
## Coefficients:
##                            Estimate Std. Error t value Pr(>|t|)    
## (Intercept)                  4.6795     0.1663  28.138   <2e-16 ***
## shared_values[TRUE]          0.2915     0.1663   1.753   0.0805 .  
## part_values[public health]  -0.1473     0.1663  -0.886   0.3763    
## sci_values[public health]    0.4119     0.1663   2.477   0.0138 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.466 on 335 degrees of freedom
##   (1 observation deleted due to missingness)
## Multiple R-squared:  0.03948,    Adjusted R-squared:  0.03088 
## F-statistic:  4.59 on 3 and 335 DF,  p-value: 0.003648
model_d = dataf |> 
    filter(disclosure) %>%
    lm(meti_mean ~ shared_values + part_values + sci_values, data = .)
summary(model_d)
## 
## Call:
## lm(formula = meti_mean ~ shared_values + part_values + sci_values, 
##     data = .)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -3.8416 -0.8981 -0.0559  0.9590  2.4590 
## 
## Coefficients:
##                            Estimate Std. Error t value Pr(>|t|)    
## (Intercept)                 4.71968    0.13216  35.711  < 2e-16 ***
## shared_values[TRUE]         0.09958    0.13216   0.753    0.451    
## part_values[public health] -0.17873    0.13216  -1.352    0.177    
## sci_values[public health]   0.62967    0.13216   4.764 2.41e-06 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.285 on 563 degrees of freedom
##   (93 observations deleted due to missingness)
## Multiple R-squared:  0.0701, Adjusted R-squared:  0.06514 
## F-statistic: 14.15 on 3 and 563 DF,  p-value: 6.696e-09
plot_residuals(model_d)
## `geom_smooth()` using formula 'y ~ x'

# plot_estimate(model_d, 'shared_values')
plot_estimate(list(emad = model_d_emad, 
                   hl = model_d), 
              str_detect(term, 'shared_values'))

But we can include demographics to check the accuracy of the graph. In the Elliott et al. data, this holds true: adding other demographics doesn’t change the estimated effect for shared values of 0.4.

model_d1 = dataf |> 
    filter(disclosure) %>% 
    lm(meti_mean ~ shared_values + part_values + sci_values +
           age + gender + race_ethnicity + religious_affil + religious_serv + 
           political_ideology + education,
       data = .)
broom::tidy(model_d1)
## # A tibble: 47 × 5
##    term                                    estimate std.error statistic  p.value
##    <chr>                                      <dbl>     <dbl>     <dbl>    <dbl>
##  1 (Intercept)                              4.48      0.410      10.9   5.54e-25
##  2 shared_values[TRUE]                      0.0703    0.144       0.489 6.25e- 1
##  3 part_values[public health]              -0.170     0.161      -1.05  2.93e- 1
##  4 sci_values[public health]                0.620     0.142       4.36  1.56e- 5
##  5 age                                     -0.00175   0.00389    -0.451 6.52e- 1
##  6 gender[Man/Male.Man/Male]                0.207     0.116       1.78  7.51e- 2
##  7 gender[Man/Male.Woman/Female]            1.09      0.925       1.17  2.41e- 1
##  8 gender[Genderqueer/Gender non-binary/G… -1.29      0.917      -1.40  1.61e- 1
##  9 gender[Genderqueer/Gender non-binary/G… -0.691     0.949      -0.728 4.67e- 1
## 10 gender[Woman/Female.Man/Male]            0.498     0.767       0.650 5.16e- 1
## # … with 37 more rows

And actually participant values is independent of shared values: from a participant’s perspective (given their values), they have an equal chance of seeing a scientist with same or different values.

dataf |> 
    filter(disclosure) |> 
    count(part_values, sci_values, shared_values)
## # A tibble: 6 × 4
##   part_values     sci_values      shared_values     n
##   <chr>           <chr>           <lgl>         <int>
## 1 economic growth economic growth TRUE             66
## 2 economic growth public health   FALSE            55
## 3 public health   economic growth FALSE           225
## 4 public health   public health   TRUE            221
## 5 <NA>            economic growth NA               39
## 6 <NA>            public health   NA               54

So dropping participant values from the regression doesn’t change the estimated effect of shared values.

model_d2 = dataf |> 
    filter(disclosure) %>% 
    lm(meti_mean ~ shared_values + sci_values, data = .)
summary(model_d2)
## 
## Call:
## lm(formula = meti_mean ~ shared_values + sci_values, data = .)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -3.8799 -0.8799 -0.0529  0.9851  2.4215 
## 
## Coefficients:
##                           Estimate Std. Error t value Pr(>|t|)    
## (Intercept)                4.57851    0.08111  56.447  < 2e-16 ***
## shared_values[TRUE]        0.11272    0.13190   0.855    0.393    
## sci_values[public health]  0.61720    0.13194   4.678 3.63e-06 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.286 on 564 degrees of freedom
##   (93 observations deleted due to missingness)
## Multiple R-squared:  0.06708,    Adjusted R-squared:  0.06377 
## F-statistic: 20.28 on 2 and 564 DF,  p-value: 3.139e-09

But scientist values does confound the estimate.

model_d3 = dataf |> 
    filter(disclosure) %>%
    lm(meti_mean ~ shared_values, data = .)
summary(model_d3)
## 
## Call:
## lm(formula = meti_mean ~ shared_values, data = .)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -3.7379 -0.9522 -0.0236  0.9954  2.3003 
## 
## Coefficients:
##                     Estimate Std. Error t value Pr(>|t|)    
## (Intercept)          4.69974    0.07827  60.047  < 2e-16 ***
## shared_values[TRUE]  0.46676    0.11001   4.243 2.58e-05 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.31 on 565 degrees of freedom
##   (93 observations deleted due to missingness)
## Multiple R-squared:  0.03088,    Adjusted R-squared:  0.02916 
## F-statistic:    18 on 1 and 565 DF,  p-value: 2.579e-05

Scientist values

We didn’t specify this possibility in advance, but all this suggests scientist values, not shared values, have an effect. This is randomly assigned, so no adjustments needed.

plot_adjustments(dag, 'sci_values') +
    scale_color_manual(values = 'black')

model_emad_s = emad_df |> 
    filter(disclosure) %>% 
    lm(pa_mean ~ sci_values, data = .)
model_s = dataf |> 
    filter(disclosure) %>%
    lm(meti_mean ~ sci_values, data = .)

summary(model_s)
## 
## Call:
## lm(formula = meti_mean ~ sci_values, data = .)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -3.8398 -0.8565 -0.0496  1.0185  2.3790 
## 
## Coefficients:
##                           Estimate Std. Error t value Pr(>|t|)    
## (Intercept)                4.62100    0.07089  65.185  < 2e-16 ***
## sci_values[public health]  0.64740    0.10025   6.458 2.07e-10 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.288 on 658 degrees of freedom
## Multiple R-squared:  0.0596, Adjusted R-squared:  0.05817 
## F-statistic:  41.7 on 1 and 658 DF,  p-value: 2.067e-10
plot_estimate(list('emad' = model_emad_s, 
                   'hl' = model_s), 
              str_detect(term, 'sci_values'))

dataf |> 
    filter(disclosure, !is.na(part_values)) |> 
    ggplot(aes(sci_values, meti_mean)) +
    # geom_violin(draw_quantiles = .5) +
    geom_beeswarm(dodge.width = 1, alpha = .25) +
    geom_ribbon(data = plot_predictions(model_s, 
                                        focal_vars = 'sci_values', 
                                        return_plot = FALSE), 
                aes(y = .fitted, ymin = .lower, ymax = .upper), 
                alpha = .25, group = 1L, fill = 'blue') +
    geom_line(data = plot_predictions(model_s, 
                                      focal_vars = 'sci_values', 
                                      return_plot = FALSE), 
              aes(y = .fitted, ymin = .lower, ymax = .upper), 
              alpha = 1, group = 1L, fill = 'blue')
## Warning: Ignoring unknown parameters: fill
## Warning: Ignoring unknown aesthetics: ymin, ymax

## One big regression table
shared_values_tbl = list(univariate = tbl_regression(model_d3, 
                                                     intercept = TRUE,
                                                     label = c(shared_values ~ 'shared values')), 
                         sci_values = tbl_regression(model_d2, 
                                                     intercept = TRUE,
                                                     label = c(shared_values ~ 'shared values', 
                                                               sci_values ~ 'scientist values')),
                         part_values = tbl_regression(model_d, 
                                                      intercept = TRUE,
                                                      label = c(shared_values ~ 'shared values', 
                                                                sci_values ~ 'scientist values', 
                                                                part_values ~ 'participant values')),
                         demo = tbl_regression(model_d1, 
                                               intercept = TRUE,
                                               label = c(shared_values ~ 'shared values', 
                                                         sci_values ~ 'scientist values', 
                                                         part_values ~ 'participant values', 
                                                         religious_serv ~ 'rel. serv. attendance',
                                                         political_ideology ~ 'political id.'), 
                                               include = -c(gender, race_ethnicity, 
                                                            religious_affil)), 
                         sci_values_alone = tbl_regression(model_s, 
                                                           intercept = TRUE,
                                                           label = c(sci_values ~ 'scientist values'))) |> 
    map(add_glance_table, include = c(r.squared, nobs, adj.r.squared,
                                      statistic, p.value)) |>
    tbl_merge(tab_spanner = c('(1) univariate', 
                              '(2) scientist values',
                              '(3) participant values',
                              '(4) demographics', 
                              '(5) scientist values alone')) |> 
    modify_table_body(~ arrange(.x, row_type == "glance_statistic"))

shared_values_tbl
Characteristic (1) univariate (2) scientist values (3) participant values (4) demographics (5) scientist values alone
Beta 95% CI1 p-value Beta 95% CI1 p-value Beta 95% CI1 p-value Beta 95% CI1 p-value Beta 95% CI1 p-value
(Intercept) 4.7 4.5, 4.9 <0.001 4.6 4.4, 4.7 <0.001 4.7 4.5, 5.0 <0.001 4.5 3.7, 5.3 <0.001 4.6 4.5, 4.8 <0.001
shared values
shared_values[TRUE] 0.47 0.25, 0.68 <0.001 0.11 -0.15, 0.37 0.4 0.10 -0.16, 0.36 0.5 0.07 -0.21, 0.35 0.6
scientist values
sci_values[public health] 0.62 0.36, 0.88 <0.001 0.63 0.37, 0.89 <0.001 0.62 0.34, 0.90 <0.001 0.65 0.45, 0.84 <0.001
participant values
part_values[public health] -0.18 -0.44, 0.08 0.2 -0.17 -0.49, 0.15 0.3
age 0.00 -0.01, 0.01 0.7
rel. serv. attendance 0.01 -0.08, 0.10 0.9
political id. -0.01 -0.09, 0.06 0.8
education 0.05 -0.18, 0.28 0.6
0.031 0.067 0.070 0.143 0.060
No. Obs. 567 567 567 538 660
Adjusted R² 0.029 0.064 0.065 0.065 0.058
Statistic 18.0 20.3 14.1 1.83 41.7
p-value <0.001 <0.001 <0.001 0.001 <0.001
1 CI = Confidence Interval
write_reg_tbl(shared_values_tbl, here(out_dir, '03_shared_values_tbl'))


## E. Variation in effects ----

E. Variation in effects

The magnitude of the effects above vary depending on whether the participant prioritizes public health or economic growth.

B: Consumer risk sensitivity

For B and C, bringing in participant values introduces a potential back-door path through demographics. This is very similar to D. Fortunately, as also with D, we just need to control part_values (and conclusion).

dag |> 
    add_arrows(c('part_values -> conclusion_x_part_values <- conclusion', 
                 'conclusion_x_part_values -> METI <- conclusion')) |> 
    plot_adjustments('conclusion_x_part_values')

model_eb_emad = lm(pa_mean ~ conclusion*part_values, data = emad_df)
summary(model_eb_emad)
## 
## Call:
## lm(formula = pa_mean ~ conclusion * part_values, data = emad_df)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -4.7437 -0.8610  0.1599  1.0251  2.5965 
## 
## Coefficients:
##                                                            Estimate Std. Error
## (Intercept)                                                  5.4116     0.1417
## conclusion[does not cause harm]                             -0.5505     0.2026
## part_values[public health]                                   0.3321     0.1819
## conclusion[does not cause harm]:part_values[public health]  -0.7897     0.2557
##                                                            t value Pr(>|t|)    
## (Intercept)                                                 38.189  < 2e-16 ***
## conclusion[does not cause harm]                             -2.717  0.00682 ** 
## part_values[public health]                                   1.826  0.06853 .  
## conclusion[does not cause harm]:part_values[public health]  -3.089  0.00213 ** 
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.374 on 492 degrees of freedom
##   (2 observations deleted due to missingness)
## Multiple R-squared:  0.1429, Adjusted R-squared:  0.1377 
## F-statistic: 27.35 on 3 and 492 DF,  p-value: 2.243e-16
model_eb = lm(meti_mean ~ conclusion*part_values, data = dataf)
summary(model_eb)
## 
## Call:
## lm(formula = meti_mean ~ conclusion * part_values, data = dataf)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -3.9199 -0.7056  0.0087  0.8658  2.6042 
## 
## Coefficients:
##                                                            Estimate Std. Error
## (Intercept)                                                  5.3876     0.1131
## conclusion[does not cause harm]                             -0.7541     0.1673
## part_values[public health]                                   0.1752     0.1312
## conclusion[does not cause harm]:part_values[public health]  -0.4128     0.1912
##                                                            t value Pr(>|t|)    
## (Intercept)                                                 47.632  < 2e-16 ***
## conclusion[does not cause harm]                             -4.509 7.45e-06 ***
## part_values[public health]                                   1.335   0.1823    
## conclusion[does not cause harm]:part_values[public health]  -2.159   0.0311 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.175 on 840 degrees of freedom
##   (144 observations deleted due to missingness)
## Multiple R-squared:  0.1763, Adjusted R-squared:  0.1734 
## F-statistic: 59.95 on 3 and 840 DF,  p-value: < 2.2e-16
plot_residuals(model_eb)
## `geom_smooth()` using formula 'y ~ x'

# plot_estimate(model_eb, ':')
# plot_estimate(list(emad = model_eb_emad, 
#                    hl = model_eb), 
#               str_detect(term, ':'))

plot_predictions(model_eb, c('conclusion', 'part_values'), 
                 interaction_ci = TRUE)

plot_estimate(list(base = model_b, interaction = model_eb), 
              str_detect(term, 'conclusion'))

list(base = model_b, interaction = model_eb) |> 
    reg_tbl(labs = c('base', 'interaction'))
Characteristic base interaction
Beta 95% CI1 p-value Beta 95% CI1 p-value
(Intercept) 5.5 5.4, 5.6 <0.001 5.4 5.2, 5.6 <0.001
conclusion
conclusion[does not cause harm] -1.0 -1.1, -0.84 <0.001 -0.75 -1.1, -0.43 <0.001
part_values
part_values[public health] 0.18 -0.08, 0.43 0.2
conclusion * part_values
conclusion[does not cause harm] * part_values[public health] -0.41 -0.79, -0.04 0.031
0.148 0.176
No. Obs. 988 844
Adjusted R² 0.147 0.173
Statistic 171 59.9
p-value <0.001 <0.001
1 CI = Confidence Interval

Again, include demographics as a check

model_eb1 = lm(meti_mean ~ conclusion*part_values + 
                   age + gender + race_ethnicity + religious_affil + 
                   religious_serv + political_ideology + education,
               data = dataf)
summary(model_eb1)
## 
## Call:
## lm(formula = meti_mean ~ conclusion * part_values + age + gender + 
##     race_ethnicity + religious_affil + religious_serv + political_ideology + 
##     education, data = dataf)
## 
## Residuals:
##    Min     1Q Median     3Q    Max 
## -3.703 -0.689  0.000  0.815  2.839 
## 
## Coefficients: (1 not defined because of singularities)
##                                                                                                               Estimate
## (Intercept)                                                                                                   5.269896
## conclusion[does not cause harm]                                                                              -0.725321
## part_values[public health]                                                                                    0.199800
## age                                                                                                           0.002336
## gender[Man/Male.Man/Male]                                                                                     0.061406
## gender[Man/Male.Woman/Female]                                                                                 0.668535
## gender[Genderqueer/Gender non-binary/Gender fluid.Genderqueer/Gender non-binary/Gender fluid]                -1.420756
## gender[Genderqueer/Gender non-binary/Gender fluid.Man/Male]                                                  -1.319357
## gender[Woman/Female.Man/Male]                                                                                -0.811087
## gender[Man/Male & Genderqueer/Gender non-binary/Gender fluid.Man/Male]                                       -1.813567
## gender[Genderqueer/Gender non-binary/Gender fluid.Woman/Female]                                              -0.510207
## gender[Genderqueer/Gender non-binary/Gender fluid.Woman/Female & Genderqueer/Gender non-binary/Gender fluid]  1.197609
## gender[Different Identity.Genderqueer/Gender non-binary/Gender fluid]                                         1.392368
## gender[Genderqueer/Gender non-binary/Gender fluid.Indigenous or other cultural gender minority identity]      0.803310
## gender[Man/Male.Indigenous or other cultural gender minority identity]                                       -1.415886
## gender[Woman/Female.Woman/Female & Man/Male]                                                                  1.022698
## race_ethnicity[3]                                                                                             0.169188
## race_ethnicity[2]                                                                                             0.008730
## race_ethnicity[4]                                                                                             0.296248
## race_ethnicity[2,5]                                                                                          -0.344107
## race_ethnicity[4,5]                                                                                           0.235121
## race_ethnicity[1,5]                                                                                          -0.186294
## race_ethnicity[3,5]                                                                                           0.620084
## race_ethnicity[1]                                                                                             0.247225
## race_ethnicity[6]                                                                                             0.134925
## race_ethnicity[3,4]                                                                                           0.542722
## race_ethnicity[1,3]                                                                                           0.652296
## race_ethnicity[1,3,5]                                                                                         1.425109
## race_ethnicity[1,4,5]                                                                                        -0.506392
## race_ethnicity[2,4,5]                                                                                         0.910759
## race_ethnicity[5,6]                                                                                                 NA
## race_ethnicity[6,7]                                                                                          -1.774866
## religious_affil[6]                                                                                            0.266205
## religious_affil[2]                                                                                            0.145139
## religious_affil[8]                                                                                            0.491350
## religious_affil[9]                                                                                            0.024232
## religious_affil[4]                                                                                            0.647875
## religious_affil[1]                                                                                            0.366487
## religious_affil[5]                                                                                            0.671171
## religious_affil[3]                                                                                            0.081191
## religious_affil[7,8]                                                                                          0.570199
## religious_affil[1,2]                                                                                          0.535704
## religious_affil[1,6]                                                                                         -0.854535
## religious_affil[1,7]                                                                                          0.481840
## religious_affil[2,7]                                                                                          0.009369
## religious_affil[4,7]                                                                                          0.682151
## religious_affil[6,9]                                                                                          1.667394
## religious_affil[8,9]                                                                                          1.191154
## religious_serv                                                                                               -0.014953
## political_ideology                                                                                           -0.022497
## education                                                                                                    -0.043906
## conclusion[does not cause harm]:part_values[public health]                                                   -0.463876
##                                                                                                              Std. Error
## (Intercept)                                                                                                    0.297492
## conclusion[does not cause harm]                                                                                0.176724
## part_values[public health]                                                                                     0.148537
## age                                                                                                            0.002882
## gender[Man/Male.Man/Male]                                                                                      0.087234
## gender[Man/Male.Woman/Female]                                                                                  0.834456
## gender[Genderqueer/Gender non-binary/Gender fluid.Genderqueer/Gender non-binary/Gender fluid]                  0.682826
## gender[Genderqueer/Gender non-binary/Gender fluid.Man/Male]                                                    0.623232
## gender[Woman/Female.Man/Male]                                                                                  0.593137
## gender[Man/Male & Genderqueer/Gender non-binary/Gender fluid.Man/Male]                                         1.169456
## gender[Genderqueer/Gender non-binary/Gender fluid.Woman/Female]                                                0.876076
## gender[Genderqueer/Gender non-binary/Gender fluid.Woman/Female & Genderqueer/Gender non-binary/Gender fluid]   1.183602
## gender[Different Identity.Genderqueer/Gender non-binary/Gender fluid]                                          1.168886
## gender[Genderqueer/Gender non-binary/Gender fluid.Indigenous or other cultural gender minority identity]       1.170160
## gender[Man/Male.Indigenous or other cultural gender minority identity]                                         1.229431
## gender[Woman/Female.Woman/Female & Man/Male]                                                                   1.181591
## race_ethnicity[3]                                                                                              0.133069
## race_ethnicity[2]                                                                                              0.192705
## race_ethnicity[4]                                                                                              0.245233
## race_ethnicity[2,5]                                                                                            0.399441
## race_ethnicity[4,5]                                                                                            0.481519
## race_ethnicity[1,5]                                                                                            0.559966
## race_ethnicity[3,5]                                                                                            0.485083
## race_ethnicity[1]                                                                                              0.589822
## race_ethnicity[6]                                                                                              0.606086
## race_ethnicity[3,4]                                                                                            0.711323
## race_ethnicity[1,3]                                                                                            1.187150
## race_ethnicity[1,3,5]                                                                                          1.171498
## race_ethnicity[1,4,5]                                                                                          1.170419
## race_ethnicity[2,4,5]                                                                                          1.175382
## race_ethnicity[5,6]                                                                                                  NA
## race_ethnicity[6,7]                                                                                            1.291521
## religious_affil[6]                                                                                             0.130309
## religious_affil[2]                                                                                             0.156570
## religious_affil[8]                                                                                             0.167107
## religious_affil[9]                                                                                             0.233107
## religious_affil[4]                                                                                             0.289311
## religious_affil[1]                                                                                             0.368428
## religious_affil[5]                                                                                             0.499712
## religious_affil[3]                                                                                             0.514410
## religious_affil[7,8]                                                                                           0.830187
## religious_affil[1,2]                                                                                           1.191750
## religious_affil[1,6]                                                                                           1.168884
## religious_affil[1,7]                                                                                           1.185778
## religious_affil[2,7]                                                                                           1.173376
## religious_affil[4,7]                                                                                           1.168637
## religious_affil[6,9]                                                                                           1.169145
## religious_affil[8,9]                                                                                           1.664191
## religious_serv                                                                                                 0.035004
## political_ideology                                                                                             0.028822
## education                                                                                                      0.086157
## conclusion[does not cause harm]:part_values[public health]                                                     0.202327
##                                                                                                              t value
## (Intercept)                                                                                                   17.714
## conclusion[does not cause harm]                                                                               -4.104
## part_values[public health]                                                                                     1.345
## age                                                                                                            0.811
## gender[Man/Male.Man/Male]                                                                                      0.704
## gender[Man/Male.Woman/Female]                                                                                  0.801
## gender[Genderqueer/Gender non-binary/Gender fluid.Genderqueer/Gender non-binary/Gender fluid]                 -2.081
## gender[Genderqueer/Gender non-binary/Gender fluid.Man/Male]                                                   -2.117
## gender[Woman/Female.Man/Male]                                                                                 -1.367
## gender[Man/Male & Genderqueer/Gender non-binary/Gender fluid.Man/Male]                                        -1.551
## gender[Genderqueer/Gender non-binary/Gender fluid.Woman/Female]                                               -0.582
## gender[Genderqueer/Gender non-binary/Gender fluid.Woman/Female & Genderqueer/Gender non-binary/Gender fluid]   1.012
## gender[Different Identity.Genderqueer/Gender non-binary/Gender fluid]                                          1.191
## gender[Genderqueer/Gender non-binary/Gender fluid.Indigenous or other cultural gender minority identity]       0.686
## gender[Man/Male.Indigenous or other cultural gender minority identity]                                        -1.152
## gender[Woman/Female.Woman/Female & Man/Male]                                                                   0.866
## race_ethnicity[3]                                                                                              1.271
## race_ethnicity[2]                                                                                              0.045
## race_ethnicity[4]                                                                                              1.208
## race_ethnicity[2,5]                                                                                           -0.861
## race_ethnicity[4,5]                                                                                            0.488
## race_ethnicity[1,5]                                                                                           -0.333
## race_ethnicity[3,5]                                                                                            1.278
## race_ethnicity[1]                                                                                              0.419
## race_ethnicity[6]                                                                                              0.223
## race_ethnicity[3,4]                                                                                            0.763
## race_ethnicity[1,3]                                                                                            0.549
## race_ethnicity[1,3,5]                                                                                          1.216
## race_ethnicity[1,4,5]                                                                                         -0.433
## race_ethnicity[2,4,5]                                                                                          0.775
## race_ethnicity[5,6]                                                                                               NA
## race_ethnicity[6,7]                                                                                           -1.374
## religious_affil[6]                                                                                             2.043
## religious_affil[2]                                                                                             0.927
## religious_affil[8]                                                                                             2.940
## religious_affil[9]                                                                                             0.104
## religious_affil[4]                                                                                             2.239
## religious_affil[1]                                                                                             0.995
## religious_affil[5]                                                                                             1.343
## religious_affil[3]                                                                                             0.158
## religious_affil[7,8]                                                                                           0.687
## religious_affil[1,2]                                                                                           0.450
## religious_affil[1,6]                                                                                          -0.731
## religious_affil[1,7]                                                                                           0.406
## religious_affil[2,7]                                                                                           0.008
## religious_affil[4,7]                                                                                           0.584
## religious_affil[6,9]                                                                                           1.426
## religious_affil[8,9]                                                                                           0.716
## religious_serv                                                                                                -0.427
## political_ideology                                                                                            -0.781
## education                                                                                                     -0.510
## conclusion[does not cause harm]:part_values[public health]                                                    -2.293
##                                                                                                              Pr(>|t|)
## (Intercept)                                                                                                   < 2e-16
## conclusion[does not cause harm]                                                                               4.5e-05
## part_values[public health]                                                                                    0.17899
## age                                                                                                           0.41789
## gender[Man/Male.Man/Male]                                                                                     0.48170
## gender[Man/Male.Woman/Female]                                                                                 0.42329
## gender[Genderqueer/Gender non-binary/Gender fluid.Genderqueer/Gender non-binary/Gender fluid]                 0.03780
## gender[Genderqueer/Gender non-binary/Gender fluid.Man/Male]                                                   0.03459
## gender[Woman/Female.Man/Male]                                                                                 0.17189
## gender[Man/Male & Genderqueer/Gender non-binary/Gender fluid.Man/Male]                                        0.12138
## gender[Genderqueer/Gender non-binary/Gender fluid.Woman/Female]                                               0.56049
## gender[Genderqueer/Gender non-binary/Gender fluid.Woman/Female & Genderqueer/Gender non-binary/Gender fluid]  0.31194
## gender[Different Identity.Genderqueer/Gender non-binary/Gender fluid]                                         0.23396
## gender[Genderqueer/Gender non-binary/Gender fluid.Indigenous or other cultural gender minority identity]      0.49261
## gender[Man/Male.Indigenous or other cultural gender minority identity]                                        0.24983
## gender[Woman/Female.Woman/Female & Man/Male]                                                                  0.38703
## race_ethnicity[3]                                                                                             0.20397
## race_ethnicity[2]                                                                                             0.96388
## race_ethnicity[4]                                                                                             0.22742
## race_ethnicity[2,5]                                                                                           0.38925
## race_ethnicity[4,5]                                                                                           0.62549
## race_ethnicity[1,5]                                                                                           0.73946
## race_ethnicity[3,5]                                                                                           0.20154
## race_ethnicity[1]                                                                                             0.67523
## race_ethnicity[6]                                                                                             0.82389
## race_ethnicity[3,4]                                                                                           0.44572
## race_ethnicity[1,3]                                                                                           0.58285
## race_ethnicity[1,3,5]                                                                                         0.22418
## race_ethnicity[1,4,5]                                                                                         0.66539
## race_ethnicity[2,4,5]                                                                                         0.43867
## race_ethnicity[5,6]                                                                                                NA
## race_ethnicity[6,7]                                                                                           0.16978
## religious_affil[6]                                                                                            0.04141
## religious_affil[2]                                                                                            0.35423
## religious_affil[8]                                                                                            0.00338
## religious_affil[9]                                                                                            0.91724
## religious_affil[4]                                                                                            0.02542
## religious_affil[1]                                                                                            0.32019
## religious_affil[5]                                                                                            0.17964
## religious_affil[3]                                                                                            0.87463
## religious_affil[7,8]                                                                                          0.49240
## religious_affil[1,2]                                                                                          0.65319
## religious_affil[1,6]                                                                                          0.46497
## religious_affil[1,7]                                                                                          0.68460
## religious_affil[2,7]                                                                                          0.99363
## religious_affil[4,7]                                                                                          0.55959
## religious_affil[6,9]                                                                                          0.15424
## religious_affil[8,9]                                                                                          0.47436
## religious_serv                                                                                                0.66937
## political_ideology                                                                                            0.43532
## education                                                                                                     0.61048
## conclusion[does not cause harm]:part_values[public health]                                                    0.02214
##                                                                                                                 
## (Intercept)                                                                                                  ***
## conclusion[does not cause harm]                                                                              ***
## part_values[public health]                                                                                      
## age                                                                                                             
## gender[Man/Male.Man/Male]                                                                                       
## gender[Man/Male.Woman/Female]                                                                                   
## gender[Genderqueer/Gender non-binary/Gender fluid.Genderqueer/Gender non-binary/Gender fluid]                *  
## gender[Genderqueer/Gender non-binary/Gender fluid.Man/Male]                                                  *  
## gender[Woman/Female.Man/Male]                                                                                   
## gender[Man/Male & Genderqueer/Gender non-binary/Gender fluid.Man/Male]                                          
## gender[Genderqueer/Gender non-binary/Gender fluid.Woman/Female]                                                 
## gender[Genderqueer/Gender non-binary/Gender fluid.Woman/Female & Genderqueer/Gender non-binary/Gender fluid]    
## gender[Different Identity.Genderqueer/Gender non-binary/Gender fluid]                                           
## gender[Genderqueer/Gender non-binary/Gender fluid.Indigenous or other cultural gender minority identity]        
## gender[Man/Male.Indigenous or other cultural gender minority identity]                                          
## gender[Woman/Female.Woman/Female & Man/Male]                                                                    
## race_ethnicity[3]                                                                                               
## race_ethnicity[2]                                                                                               
## race_ethnicity[4]                                                                                               
## race_ethnicity[2,5]                                                                                             
## race_ethnicity[4,5]                                                                                             
## race_ethnicity[1,5]                                                                                             
## race_ethnicity[3,5]                                                                                             
## race_ethnicity[1]                                                                                               
## race_ethnicity[6]                                                                                               
## race_ethnicity[3,4]                                                                                             
## race_ethnicity[1,3]                                                                                             
## race_ethnicity[1,3,5]                                                                                           
## race_ethnicity[1,4,5]                                                                                           
## race_ethnicity[2,4,5]                                                                                           
## race_ethnicity[5,6]                                                                                             
## race_ethnicity[6,7]                                                                                             
## religious_affil[6]                                                                                           *  
## religious_affil[2]                                                                                              
## religious_affil[8]                                                                                           ** 
## religious_affil[9]                                                                                              
## religious_affil[4]                                                                                           *  
## religious_affil[1]                                                                                              
## religious_affil[5]                                                                                              
## religious_affil[3]                                                                                              
## religious_affil[7,8]                                                                                            
## religious_affil[1,2]                                                                                            
## religious_affil[1,6]                                                                                            
## religious_affil[1,7]                                                                                            
## religious_affil[2,7]                                                                                            
## religious_affil[4,7]                                                                                            
## religious_affil[6,9]                                                                                            
## religious_affil[8,9]                                                                                            
## religious_serv                                                                                                  
## political_ideology                                                                                              
## education                                                                                                       
## conclusion[does not cause harm]:part_values[public health]                                                   *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.164 on 750 degrees of freedom
##   (187 observations deleted due to missingness)
## Multiple R-squared:  0.2364, Adjusted R-squared:  0.1855 
## F-statistic: 4.645 on 50 and 750 DF,  p-value: < 2.2e-16
eb_tbl = list(base = model_b, interaction = model_eb, demo = model_eb1) |> 
    reg_tbl(labs = c('base', 'interaction', 'demographics'))
eb_tbl
Characteristic base interaction demographics
Beta 95% CI1 p-value Beta 95% CI1 p-value Beta 95% CI1 p-value
(Intercept) 5.5 5.4, 5.6 <0.001 5.4 5.2, 5.6 <0.001 5.3 4.7, 5.9 <0.001
conclusion
conclusion[does not cause harm] -1.0 -1.1, -0.84 <0.001 -0.75 -1.1, -0.43 <0.001 -0.73 -1.1, -0.38 <0.001
part_values
part_values[public health] 0.18 -0.08, 0.43 0.2 0.20 -0.09, 0.49 0.2
conclusion * part_values
conclusion[does not cause harm] * part_values[public health] -0.41 -0.79, -0.04 0.031 -0.46 -0.86, -0.07 0.022
age 0.00 0.00, 0.01 0.4
religious_serv -0.01 -0.08, 0.05 0.7
political_ideology -0.02 -0.08, 0.03 0.4
education -0.04 -0.21, 0.13 0.6
0.148 0.176 0.236
No. Obs. 988 844 801
Adjusted R² 0.147 0.173 0.186
Statistic 171 59.9 4.64
p-value <0.001 <0.001 <0.001
1 CI = Confidence Interval
write_reg_tbl(eb_tbl, here(out_dir, '03_eb_tbl'))



emad_df |> 
    filter(!is.na(part_values), disclosure) |> 
    ggplot(aes(conclusion, pa_mean)) +
    geom_boxplot() +
    facet_wrap(vars(part_values))

dataf |> 
    filter(!is.na(part_values), disclosure) |> 
    ggplot(aes(conclusion, meti_mean)) +
    geom_beeswarm(alpha = .5, cex = 1.5, size = .5) +
    stat_summary(fun.data = mean_cl_boot, color = 'red', 
                 size = 1, fatten = 0) +
    stat_summary(fun.data = mean_cl_boot, geom = 'line', group = 1L, color = 'red') +
    facet_wrap(vars(part_values)) +
    labs(x = 'scientist conclusion: BPA ...', 
         y = 'perceived trustworthiness')

ggsave(here(out_dir, '03_conclusion_part.png'), 
       height = 3, width = 6, scale = 1, 
       bg = 'white')

C: Disclosure

dag |> 
    add_arrows(c('part_values -> disclosure_x_part_values <- disclosure', 
                 'disclosure_x_part_values -> METI', 
                 'disclosure -> METI')) |> 
    plot_adjustments('disclosure_x_part_values')

model_ec_emad = lm(pa_mean ~ disclosure*part_values, data = emad_df)
summary(model_ec_emad)
## 
## Call:
## lm(formula = pa_mean ~ disclosure * part_values, data = emad_df)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -4.4090 -1.0042  0.1387  1.1446  2.1387 
## 
## Coefficients:
##                                             Estimate Std. Error t value
## (Intercept)                                  5.35272    0.18476  28.971
## disclosure[TRUE]                            -0.32001    0.22784  -1.405
## part_values[public health]                   0.05629    0.23878   0.236
## disclosure[TRUE]:part_values[public health] -0.22770    0.29095  -0.783
##                                             Pr(>|t|)    
## (Intercept)                                   <2e-16 ***
## disclosure[TRUE]                               0.161    
## part_values[public health]                     0.814    
## disclosure[TRUE]:part_values[public health]    0.434    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.466 on 492 degrees of freedom
##   (2 observations deleted due to missingness)
## Multiple R-squared:  0.02353,    Adjusted R-squared:  0.01758 
## F-statistic: 3.953 on 3 and 492 DF,  p-value: 0.008371
lm(pa_mean ~ disclosure*part_values+ 
       sex + ideology + educatio + age, data = emad_df) |> 
    summary()
## 
## Call:
## lm(formula = pa_mean ~ disclosure * part_values + sex + ideology + 
##     educatio + age, data = emad_df)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -4.2393 -0.9427  0.1744  1.1730  2.2864 
## 
## Coefficients:
##                                              Estimate Std. Error t value
## (Intercept)                                  5.227099   0.334903  15.608
## disclosure[TRUE]                            -0.323021   0.228681  -1.413
## part_values[public health]                   0.003625   0.243423   0.015
## sex                                          0.025026   0.134675   0.186
## ideology                                     0.007676   0.042153   0.182
## educatio                                    -0.084100   0.064652  -1.301
## age                                          0.069062   0.031725   2.177
## disclosure[TRUE]:part_values[public health] -0.256452   0.291972  -0.878
##                                             Pr(>|t|)    
## (Intercept)                                   <2e-16 ***
## disclosure[TRUE]                               0.158    
## part_values[public health]                     0.988    
## sex                                            0.853    
## ideology                                       0.856    
## educatio                                       0.194    
## age                                            0.030 *  
## disclosure[TRUE]:part_values[public health]    0.380    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.459 on 484 degrees of freedom
##   (6 observations deleted due to missingness)
## Multiple R-squared:  0.03626,    Adjusted R-squared:  0.02232 
## F-statistic: 2.601 on 7 and 484 DF,  p-value: 0.01212
model_ec = lm(meti_mean ~ disclosure*part_values, data = dataf)
summary(model_ec)
## 
## Call:
## lm(formula = meti_mean ~ disclosure * part_values, data = dataf)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -3.9023 -0.9061  0.0977  1.0263  2.0977 
## 
## Coefficients:
##                                             Estimate Std. Error t value
## (Intercept)                                  5.01557    0.14634  34.273
## disclosure[TRUE]                             0.04464    0.18767   0.238
## part_values[public health]                   0.07453    0.17265   0.432
## disclosure[TRUE]:part_values[public health] -0.23243    0.21762  -1.068
##                                             Pr(>|t|)    
## (Intercept)                                   <2e-16 ***
## disclosure[TRUE]                               0.812    
## part_values[public health]                     0.666    
## disclosure[TRUE]:part_values[public health]    0.286    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.292 on 840 degrees of freedom
##   (144 observations deleted due to missingness)
## Multiple R-squared:  0.004245,   Adjusted R-squared:  0.0006885 
## F-statistic: 1.194 on 3 and 840 DF,  p-value: 0.3111
plot_residuals(model_ec)
## `geom_smooth()` using formula 'y ~ x'

# plot_estimate(model_ec, ':')
plot_estimate(list(base = model_c, interaction = model_ec),
              str_detect(term, 'disclosure'))

plot_predictions(model_ec, c('disclosure', 'part_values'), 
                 interaction_ci = TRUE)

model_ec1 = lm(meti_mean ~ disclosure * part_values + 
                   age + gender + race_ethnicity + religious_affil + 
                   religious_serv + political_ideology + education, 
               data = dataf)

ec_tbl = list(base = model_c, interaction = model_ec, demographics = model_ec1) |> 
    reg_tbl(labs = c('base', 'interaction', 'demographics'))
ec_tbl
Characteristic base interaction demographics
Beta 95% CI1 p-value Beta 95% CI1 p-value Beta 95% CI1 p-value
(Intercept) 5.1 4.9, 5.2 <0.001 5.0 4.7, 5.3 <0.001 4.9 4.3, 5.6 <0.001
disclosure
disclosure[TRUE] -0.11 -0.28, 0.06 0.2 0.04 -0.32, 0.41 0.8 0.05 -0.34, 0.43 0.8
part_values
part_values[public health] 0.07 -0.26, 0.41 0.7 0.14 -0.23, 0.51 0.5
disclosure * part_values
disclosure[TRUE] * part_values[public health] -0.23 -0.66, 0.19 0.3 -0.29 -0.74, 0.15 0.2
age 0.00 0.00, 0.01 0.5
religious_serv 0.02 -0.06, 0.09 0.7
political_ideology -0.02 -0.08, 0.04 0.5
education -0.07 -0.26, 0.11 0.4
0.002 0.004 0.071
No. Obs. 988 844 801
Adjusted R² 0.001 0.001 0.009
Statistic 1.60 1.19 1.15
p-value 0.2 0.3 0.2
1 CI = Confidence Interval
write_reg_tbl(ec_tbl, here(out_dir, '03_ec_tbl'))

dataf |> 
    filter(!is.na(part_values)) |> 
    ggplot(aes(disclosure, meti_mean)) +
    geom_boxplot() +
    # geom_beeswarm(alpha = .25) +
    facet_wrap(vars(part_values))

D: Shared values

dag |> 
    add_arrows(c('part_values -> shared_values_x_part_values <- shared_values', 
                 'shared_values_x_part_values -> METI')) |> 
    plot_adjustments('shared_values_x_part_values')

model_ed_emad = emad_df |> 
    filter(disclosure) %>%
    lm(pa_mean ~ shared_values*part_values, data = .)
summary(model_ed_emad)
## 
## Call:
## lm(formula = pa_mean ~ shared_values * part_values, data = .)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -4.0914 -0.9710  0.0515  1.0508  2.4678 
## 
## Coefficients:
##                                                Estimate Std. Error t value
## (Intercept)                                      5.0914     0.1861  27.353
## shared_values[TRUE]                             -0.1204     0.2666  -0.452
## part_values[public health]                      -0.5592     0.2306  -2.425
## shared_values[TRUE]:part_values[public health]   0.8237     0.3326   2.477
##                                                Pr(>|t|)    
## (Intercept)                                      <2e-16 ***
## shared_values[TRUE]                              0.6519    
## part_values[public health]                       0.0158 *  
## shared_values[TRUE]:part_values[public health]   0.0138 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.466 on 335 degrees of freedom
##   (1 observation deleted due to missingness)
## Multiple R-squared:  0.03948,    Adjusted R-squared:  0.03088 
## F-statistic:  4.59 on 3 and 335 DF,  p-value: 0.003648
emad_df |> 
    filter(disclosure) %>%
    lm(pa_mean ~ shared_values*part_values+ 
           sex + ideology + educatio + age, data = .) |> 
    summary()
## 
## Call:
## lm(formula = pa_mean ~ shared_values * part_values + sex + ideology + 
##     educatio + age, data = .)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -4.1096 -0.9497  0.1137  1.0829  2.5987 
## 
## Coefficients:
##                                                Estimate Std. Error t value
## (Intercept)                                     4.90369    0.37655  13.023
## shared_values[TRUE]                            -0.10460    0.26597  -0.393
## part_values[public health]                     -0.64016    0.23782  -2.692
## sex                                             0.01372    0.16314   0.084
## ideology                                        0.01906    0.05045   0.378
## educatio                                       -0.11132    0.07683  -1.449
## age                                             0.08645    0.03721   2.323
## shared_values[TRUE]:part_values[public health]  0.78037    0.33276   2.345
##                                                Pr(>|t|)    
## (Intercept)                                     < 2e-16 ***
## shared_values[TRUE]                             0.69436    
## part_values[public health]                      0.00747 ** 
## sex                                             0.93305    
## ideology                                        0.70589    
## educatio                                        0.14831    
## age                                             0.02079 *  
## shared_values[TRUE]:part_values[public health]  0.01962 *  
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.457 on 328 degrees of freedom
##   (4 observations deleted due to missingness)
## Multiple R-squared:  0.0558, Adjusted R-squared:  0.03565 
## F-statistic: 2.769 on 7 and 328 DF,  p-value: 0.008261
model_ed = dataf |> 
    filter(disclosure) %>%
    lm(meti_mean ~ shared_values*part_values, data = .)
summary(model_ed)
## 
## Call:
## lm(formula = meti_mean ~ shared_values * part_values, data = .)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -3.8416 -0.8981 -0.0559  0.9590  2.4590 
## 
## Coefficients:
##                                                Estimate Std. Error t value
## (Intercept)                                      5.3494     0.1733  30.869
## shared_values[TRUE]                             -0.5301     0.2346  -2.259
## part_values[public health]                      -0.8084     0.1933  -4.182
## shared_values[TRUE]:part_values[public health]   1.2593     0.2643   4.764
##                                                Pr(>|t|)    
## (Intercept)                                     < 2e-16 ***
## shared_values[TRUE]                              0.0243 *  
## part_values[public health]                     3.35e-05 ***
## shared_values[TRUE]:part_values[public health] 2.41e-06 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.285 on 563 degrees of freedom
##   (93 observations deleted due to missingness)
## Multiple R-squared:  0.0701, Adjusted R-squared:  0.06514 
## F-statistic: 14.15 on 3 and 563 DF,  p-value: 6.696e-09
## Including scientist values creates perfect collinearity
dataf |> 
    filter(disclosure) %>%
    lm(meti_mean ~ shared_values*part_values + sci_values, data = .) |> 
    summary()
## 
## Call:
## lm(formula = meti_mean ~ shared_values * part_values + sci_values, 
##     data = .)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -3.8416 -0.8981 -0.0559  0.9590  2.4590 
## 
## Coefficients: (1 not defined because of singularities)
##                                                Estimate Std. Error t value
## (Intercept)                                     4.71968    0.13216  35.711
## shared_values[TRUE]                             0.09958    0.13216   0.753
## part_values[public health]                     -0.17873    0.13216  -1.352
## sci_values[public health]                       0.62967    0.13216   4.764
## shared_values[TRUE]:part_values[public health]       NA         NA      NA
##                                                Pr(>|t|)    
## (Intercept)                                     < 2e-16 ***
## shared_values[TRUE]                               0.451    
## part_values[public health]                        0.177    
## sci_values[public health]                      2.41e-06 ***
## shared_values[TRUE]:part_values[public health]       NA    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.285 on 563 degrees of freedom
##   (93 observations deleted due to missingness)
## Multiple R-squared:  0.0701, Adjusted R-squared:  0.06514 
## F-statistic: 14.15 on 3 and 563 DF,  p-value: 6.696e-09
plot_estimate(list(base = model_d,
                   interaction = model_ed),
              str_detect(term, 'shared_values'))

model_ed1 = dataf |> 
    filter(disclosure) %>%
    lm(meti_mean ~ shared_values*part_values+ 
           age + gender + race_ethnicity + religious_affil + 
           religious_serv + political_ideology + education, 
       data = .)
list(model_d, model_ed, model_ed1) |> 
    reg_tbl(labs = c('base', 'interaction', 'demographics'))
Characteristic base interaction demographics
Beta 95% CI1 p-value Beta 95% CI1 p-value Beta 95% CI1 p-value
(Intercept) 4.7 4.5, 5.0 <0.001 5.3 5.0, 5.7 <0.001 5.1 4.3, 5.9 <0.001
shared_values
shared_values[TRUE] 0.10 -0.16, 0.36 0.5 -0.53 -1.0, -0.07 0.024 -0.55 -1.1, -0.05 0.031
part_values
part_values[public health] -0.18 -0.44, 0.08 0.2 -0.81 -1.2, -0.43 <0.001 -0.79 -1.2, -0.36 <0.001
sci_values
sci_values[public health] 0.63 0.37, 0.89 <0.001
shared_values * part_values
shared_values[TRUE] * part_values[public health] 1.3 0.74, 1.8 <0.001 1.2 0.68, 1.8 <0.001
age 0.00 -0.01, 0.01 0.7
religious_serv 0.01 -0.08, 0.10 0.9
political_ideology -0.01 -0.09, 0.06 0.8
education 0.05 -0.18, 0.28 0.6
0.070 0.070 0.143
No. Obs. 567 567 538
Adjusted R² 0.065 0.065 0.065
Statistic 14.1 14.1 1.83
p-value <0.001 <0.001 0.001
1 CI = Confidence Interval

Effect of shared values appears to go in opposite directions, depending on participant values

plot_predictions(model_ed, 
                 c('part_values', 'shared_values'), 
                 interaction_ci = TRUE)

dataf |> 
    filter(!is.na(part_values), disclosure) |> 
    ggplot(aes(shared_values, meti_mean)) +
    # geom_boxplot() +
    geom_beeswarm(alpha = .5, cex = 1.5, size = .5) +
    facet_wrap(vars(part_values)) +
    ## model_ed is a confounded mess;
    # geom_ribbon(data = plot_predictions(model_ed, 
    #                                     c('part_values', 'shared_values'), 
    #                                     return_plot = FALSE), 
    #             aes(y = .fitted, ymin = .lower, ymax = .upper), 
    #             group = 1L, alpha = .5, fill = 'blue') +
    # geom_line(data = plot_predictions(model_ed, 
    #                                   c('part_values', 'shared_values'), 
    #                                   return_plot = FALSE), 
    #           aes(y = .fitted, ymin = .lower, ymax = .upper), 
    #           group = 1L, alpha = 1, color = 'blue') +
    ## just do mean + CI
    stat_summary(fun.data = mean_cl_boot, color = 'red', 
             size = 1, fatten = 0) +
    stat_summary(fun.data = mean_cl_boot, geom = 'line', group = 1L, color = 'red') +
    labs(x = 'shared values', 
         y = 'perceived trustworthiness')

ggsave(here(out_dir, '03_shared_part.png'), 
       height = 3, width = 6, scale = 1, 
       bg = 'white')

And political ideology appears to be either entirely upstream or independent to this

dataf |> 
    filter(disclosure) %>%
    lm(meti_mean ~ shared_values*part_values + political_ideology, data = .) |> 
    summary()
## 
## Call:
## lm(formula = meti_mean ~ shared_values * part_values + political_ideology, 
##     data = .)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -3.8353 -0.8809 -0.0615  0.9464  2.4839 
## 
## Coefficients:
##                                                 Estimate Std. Error t value
## (Intercept)                                     5.396724   0.240008  22.486
## shared_values[TRUE]                            -0.518383   0.240109  -2.159
## part_values[public health]                     -0.856955   0.206333  -4.153
## political_ideology                             -0.003948   0.033497  -0.118
## shared_values[TRUE]:part_values[public health]  1.262260   0.269799   4.679
##                                                Pr(>|t|)    
## (Intercept)                                     < 2e-16 ***
## shared_values[TRUE]                              0.0313 *  
## part_values[public health]                     3.81e-05 ***
## political_ideology                               0.9062    
## shared_values[TRUE]:part_values[public health] 3.66e-06 ***
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.274 on 536 degrees of freedom
##   (119 observations deleted due to missingness)
## Multiple R-squared:  0.07522,    Adjusted R-squared:  0.06832 
## F-statistic:  10.9 on 4 and 536 DF,  p-value: 1.675e-08

Apparently independent

dataf |> 
    filter(disclosure) %>%
    lm(meti_mean ~ political_ideology, data = .) |> 
    summary()
## 
## Call:
## lm(formula = meti_mean ~ political_ideology, data = .)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -3.9494 -0.9437  0.0569  1.0506  2.0633 
## 
## Coefficients:
##                     Estimate Std. Error t value Pr(>|t|)    
## (Intercept)         4.954527   0.105865   46.80   <2e-16 ***
## political_ideology -0.002545   0.028266   -0.09    0.928    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.322 on 628 degrees of freedom
##   (30 observations deleted due to missingness)
## Multiple R-squared:  1.291e-05,  Adjusted R-squared:  -0.001579 
## F-statistic: 0.008105 on 1 and 628 DF,  p-value: 0.9283
dataf |> 
    filter(disclosure) |> 
    ggplot(aes(political_ideology, meti_mean, group = political_ideology)) +
    geom_violin(draw_quantiles = .5) +
    geom_beeswarm()
## Warning: Removed 30 rows containing non-finite values (stat_ydensity).
## Warning: Removed 30 rows containing missing values (position_beeswarm).

Because the effect is with scientist values (we also saw this at the end of D)

model_es = dataf |> 
    filter(disclosure) %>% 
    lm(meti_mean ~ sci_values + part_values, data = .)
summary(model_es)
## 
## Call:
## lm(formula = meti_mean ~ sci_values + part_values, data = .)
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -3.8203 -0.8918 -0.0619  0.9659  2.4381 
## 
## Coefficients:
##                            Estimate Std. Error t value Pr(>|t|)    
## (Intercept)                  4.7479     0.1267  37.478  < 2e-16 ***
## sci_values[public health]    0.6870     0.1080   6.361 4.14e-10 ***
## part_values[public health]  -0.1861     0.1318  -1.412    0.158    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.285 on 564 degrees of freedom
##   (93 observations deleted due to missingness)
## Multiple R-squared:  0.06916,    Adjusted R-squared:  0.06586 
## F-statistic: 20.95 on 2 and 564 DF,  p-value: 1.671e-09
plot_predictions(model_es, 'sci_values')

dataf |> 
    filter(!is.na(part_values), disclosure) |> 
    ggplot(aes(sci_values, meti_mean)) +
    # geom_boxplot() +
    geom_beeswarm(alpha = .5, cex = 1.5, size = .5) +
    facet_wrap(vars(part_values)) +
    # geom_ribbon(data = plot_predictions(model_es, 
    #                                     c('sci_values', 'part_values'), 
    #                                     return_plot = FALSE), 
    #             aes(y = .fitted, ymin = .lower, ymax = .upper), 
    #             group = 1L, alpha = .5, fill = 'blue') +
    # geom_line(data = plot_predictions(model_es, 
    #                                   c('sci_values', 'part_values'), 
    #                                   return_plot = FALSE), 
    #           aes(y = .fitted, ymin = .lower, ymax = .upper), 
    #           group = 1L, alpha = 1, color = 'blue') +
    stat_summary(fun.data = mean_cl_boot, color = 'red', 
                 size = 1, fatten = 0) +
    stat_summary(fun.data = mean_cl_boot, geom = 'line', group = 1L, color = 'red') +
    labs(x = 'scientist values', 
         y = 'perceived trustworthiness')

ggsave(here(out_dir, '03_sci_part.png'), height = 3, width = 6, scale = 1, bg = 'white')

Any interaction with participant values is swamped by uncertainty Though Emilio thinks this might be worth reporting bc of difference in variation btwn participant values groups How are participants thinking of economic growth? Might be thinking of indirect effects, eg, good economy -> better hospitals and public health system

dataf %>% 
    filter(disclosure) %>%
    lm(meti_mean ~ sci_values*part_values, data = .) |> 
    # summary()
    plot_predictions(c('sci_values', 'part_values'), 
                     interaction_ci = TRUE)

lm(meti_mean ~ sci_values * part_values, 
   data = filter(dataf, disclosure)) |> 
    summary()
## 
## Call:
## lm(formula = meti_mean ~ sci_values * part_values, data = filter(dataf, 
##     disclosure))
## 
## Residuals:
##     Min      1Q  Median      3Q     Max 
## -3.8416 -0.8981 -0.0559  0.9590  2.4590 
## 
## Coefficients:
##                                                      Estimate Std. Error
## (Intercept)                                            4.8193     0.1582
## sci_values[public health]                              0.5301     0.2346
## part_values[public health]                            -0.2783     0.1799
## sci_values[public health]:part_values[public health]   0.1992     0.2643
##                                                      t value Pr(>|t|)    
## (Intercept)                                           30.464   <2e-16 ***
## sci_values[public health]                              2.259   0.0243 *  
## part_values[public health]                            -1.547   0.1224    
## sci_values[public health]:part_values[public health]   0.753   0.4515    
## ---
## Signif. codes:  0 '***' 0.001 '**' 0.01 '*' 0.05 '.' 0.1 ' ' 1
## 
## Residual standard error: 1.285 on 563 degrees of freedom
##   (93 observations deleted due to missingness)
## Multiple R-squared:  0.0701, Adjusted R-squared:  0.06514 
## F-statistic: 14.15 on 3 and 563 DF,  p-value: 6.696e-09
sci_part_tbl = list(base = model_s,
     part_values = model_es,
     interaction = lm(meti_mean ~ sci_values * part_values, 
                      data = filter(dataf, disclosure)),
     demographics = lm(meti_mean ~ sci_values * part_values + 
                           age + gender + race_ethnicity + religious_affil + 
                           religious_serv + political_ideology + education, 
                       data = filter(dataf, disclosure))) |> 
    reg_tbl(labs = c('base', 'participant values', 'interaction', 'demographics'))
write_reg_tbl(sci_part_tbl, here(out_dir, '03_sci_part_tbl'))